Windows Expert/Windows Expert.iso/database/nfltpw11.zip/NFLTPW.PAS

Pascal/Delphi Source File | 1993-07-12 | 42KB | 1,361 lines

Program NFLTPW;
{$r nfltpw.res}
uses WinTypes, WinProcs, WObjects, Printer,
     win31,bitmap,Strings,stddlgs;
const
     MaxTeams = 28;
     MaxGames = 14;
     MaxWeeks = 18;
     PlayerNameSize = 20;
     ScoreFieldSize = 3;
     TeamNameSize   = 25;
     DLLName = 'NFLLIB.DLL';
     em_DLLNotFound    = 1;
     cm_PlayerMaint    = 102;
     cm_DeletePlayers  = 103;
     cm_DeleteSchedule = 104;
     cm_EnterSchedule  = 105;
     cm_EnterPicks     = 202;
     cm_EnterScores    = 203;
     cm_PrintSchedule  = 301;
     cm_PrintResults   = 302;
     cm_SetupPrinter   = 303;
     cm_about          = 401;
     id_AddPlayer      = 102;
     id_DeletePlayer   = 103;
     id_BoxMask        = 100;
     id_ButtonMask     = 100;
     id_TeamMask       = 200;
     id_week           = 11;
     id_PlayerCombo    = 12;
     id_PickPoints     = 13;
     id_PlayerBox      = 101;
     id_Transparent    = 10;
type
    pMyDialog = ^tMyDialog;
    tmyDialog = object(tDialog)
    constructor init(aParent:pWindowsObject; aName:pChar);
       procedure wmCtlColor(var Msg:tMessage);
                 virtual wm_first + wm_CtlColor;
    end;

    PickType = (Visitor,Home,None);

    tNFLApp = object(tApplication)
        Lib: THandle;
        constructor Init(AName: PChar);
        destructor  done;   virtual;
        procedure   InitMainWindow; virtual;
        procedure   WritePlayerList; virtual;
    end;

  pMyListBox = ^tMyListBox;
  tmyListBox = object(tlistbox)
    procedure wmVScroll(var msg:tmessage); virtual wm_first + wm_VScroll;
  end;

  procedure tmylistbox.wmVScroll(var msg:tmessage);
  begin
     case msg.wparam of
       sb_LineDown:
          if GetSelIndex <> getcount then
          begin
               SetSelIndex(GetSelIndex + 1);
               sendmessage(Parent^.hwindow,wm_command,getid,
                           hwindow or (lbn_selchange shl 16));
          end;
       sb_LineUp  :
          if GetSelIndex <> 0 then
          begin
               SetSelIndex(GetSelIndex - 1);
               sendmessage(Parent^.hwindow,wm_command,getid,
                           hwindow or (lbn_selchange shl 16));
          end;
     else DefWndProc(msg);
     end;
  end;

var NFLApp : tNFLApp;

constructor tmydialog.init(aParent:pWindowsObject; aName:pChar);
begin
     tdialog.init(aparent,aname);
end;

type
   ListRec = record
       ListStrings : pStrCollection;
       ListSelection : integer;
   end;

   ComboRec = record
        ComboStrings   : pStrCollection;
        ComboSelection : array[0..20] of Char;
   end;

   SchdTransferRec = record
       STRWeek  : ListRec;
       STRTeams : array[1..MaxTeams] of ComboRec;
   end;

   TeamRec = record
          Name  : array[0..PlayerNameSize] of char;
          Score : array[0..3] of char;
   end;

   Scores = record
            Score : array [1..MaxGames,0..1] of byte;
   end;

   Schedule = record
              Team      : array [1..MaxGames,0..1] of byte;
              GameScore : Scores
   end;
    PickData = record
               GamePick : array [1..14] of word;
               MNFScore : integer;
    end;

    ResultData = record
                 Wins,
                 Losses,
                 Ties,
                 PtDiff : word;
    end;

    Player = record
             Name    : pchar;
             PickRec : array [1..MaxWeeks] of PickData;
             Results : array [1..MaxWeeks] of ResultData;
    end;

    tPickRec = array [1..MaxWeeks] of PickData;
    tResults = array [1..MaxWeeks] of ResultData;

    pPlayer = ^tPlayer;
    tPlayer = object(tObject)
              Name    : pchar;
              PickRec : tPickRec;
              Results : tResults;
          constructor init(NewName    : pchar;
                           NewPickRec : tPickRec;
                           NewResults : tResults);
          constructor Load(var s:tstream);
          procedure Store(var s:tstream); virtual;
          destructor Done; virtual;
   end;

   tPlayerCollection = record
      vs    : pstringcollection;
      focus : word;
    end;

const
  rPlayer : tstreamrec = (
            objtype : 150;
            vmtlink: ofs(typeof(tplayer)^);
            load : @tplayer.load;
            store: @tplayer.store);

   constructor tPlayer.Init(NewName    : pchar;
                           NewPickRec : tPickRec;
                           NewResults : tResults);
   begin
        tobject.init;
        Name    := NewName;
        PickRec := NewPickRec;
        Results := NewResults;
   end;
   constructor tplayer.load(var s:tstream);
   begin
        name := s.strread;
        s.read(pickrec,sizeof(pickrec));
        s.read(results,sizeof(results));
   end;
   procedure tplayer.store(var s:tstream);
   begin
        s.strwrite(Name);
        s.write(PickRec,sizeof(PickRec));
        s.write(Results,sizeof(Results));
   end;
   destructor tPlayer.done;
   begin
        StrDispose(Name);
        tobject.done;
   end;
type
    pStandings = ^tStandings;
    tStandings = object(tObject)
              Wins,
              Losses,
              Ties,
              PtDiff  : word;
              Name    : pchar;
          constructor init(NewName    : pchar;
                           NewWins,
                           NewLosses,
                           NewTies,
                           NewPtDiff : word);
          destructor Done; virtual;
   end;
   constructor tStandings.init(NewName    : pchar;
                               NewWins,
                               NewLosses,
                               NewTies,
                               NewPtDiff : word);
   begin
        tobject.init;
        Name    := NewName;
        Wins    := newwins;
        Losses  := newlosses;
        ties    := newties;
        PtDiff  := newptdiff;
   end;

   destructor tStandings.done;
   begin
        tobject.done;
   end;
type
   pStandingsCollection = ^tStandingsCollection;
   tStandingsCollection = object(tSortedCollection)
       function KeyOf(Item:pointer): pointer; virtual;
       function Compare(key1, key2: pointer):integer; virtual;
   end;

   function tStandingsCollection.KeyOf(item:pointer): pointer;
   begin
        KeyOf := pstandings(item);
   end;

   function tStandingsCollection.Compare(key1,key2:pointer):integer;
   begin
        if pstandings(key1)^.Wins < pstandings(key2)^.Wins
        then compare := 1
        else if pstandings(key1)^.Wins > pstandings(key2)^.Wins
             then compare := -1
             else if pstandings(key1)^.PtDiff > pstandings(key2)^.PtDiff
                  then compare :=  1
                  else compare := -1;
   end;

type
   pSchedule = ^tSchedule;
   tSchedule = object(tObject)
               ScheduleRec : Schedule;
        constructor init(NewSchedule : Schedule);
        constructor load(var s:tBufStream);
        procedure   store(var s:tBufStream); virtual;
        destructor  done; virtual;
    end;

  pNumericEdit = ^tNumericEdit;
  tNumericEdit = object(tEdit)
    procedure wmchar(var Msg:tMessage);virtual Wm_first + wm_char;
  end;

  pSchDialog = ^tSchDialog;
  tSchDialog = object(tMyDialog)
    sWeek : pMyListBox;
    combo : array [1..MaxTeams] of pcombobox;
    constructor init(aParent:pWindowsObject; aName:pChar);
    procedure setupwindow; virtual;
    procedure StoreSched;
    procedure Ok(var Msg: TMessage);
      virtual id_First + id_ok;
    procedure HandleListBox(var Msg:tMessage);
      virtual id_first + id_Week;
    end;

  pScoreDialog = ^tScoreDialog;
  tScoreDialog = object(tMyDialog)
    scoreWeek : pMyListBox;
    TeamName  : array [1..MaxTeams] of pStatic;
    ScoreEdit : array [1..MaxTeams] of pNumericEdit;
    constructor init(aParent:pWindowsObject; aName:pChar);
    procedure SetupWindow; virtual;
    procedure BuildSchedule;
    procedure StoreScores;
    procedure Ok(var Msg: TMessage);
                         virtual id_First + id_ok;
    procedure HandleListBox(var Msg:tMessage);
                         virtual id_first + id_Week;
    procedure wmCtlColor(var Msg:tMessage);
                         virtual wm_first + wm_CtlColor;
    end;

  pPrintSchedDlg = ^tPrintSchedDlg;
  tPrintSchedDlg = object(tMyDialog)
    PrintWeek : pMyListBox;
    constructor init(aParent:pWindowsObject; aName:pChar);
    procedure   setupwindow; virtual;
    procedure   HandleListBox(var Msg:tMessage);
                              virtual id_first + id_Week;
    end;

  pPicksDialog = ^tPicksDialog;
  tPicksDialog = object(tMyDialog)
    PickWeek   : pMyListBox;
    PickPlayer : pComboBox;
    PickPoints : pNumericEdit;
    FoundPlayer: pPlayer;
    ButtonName : array [1..maxteams*3] of pRadioButton;
    constructor init(aParent:pWindowsObject; aName:pChar);
    destructor  done;        virtual;
    procedure   setupwindow; virtual;
    procedure   StorePicks;
    procedure   BuildButtons;
    procedure   Cancel(var Msg: TMessage);
                       virtual id_First + id_Cancel;
    procedure   OK(var Msg: TMessage);
                       virtual id_First + id_OK;
    procedure   HandleListBox(var Msg:tMessage);
                       virtual id_first + id_Week;
    procedure   HandleComboBox(var Msg:tMessage);
                       virtual id_first + id_PlayerCombo;
  end;

  pPlayerMaintDlg = ^tPlayerMaintDlg;
  tPlayerMaintDlg = object(tMyDialog)
    PlayerListBox : pMyListBox;
    constructor init(aParent:pWindowsObject; aName:pChar);
    destructor  done;        virtual;
    procedure   setupwindow; virtual;
    procedure   DeletePlayer (var Msg:tMessage);
                              virtual id_first + id_DeletePlayer;
    procedure   AddPlayer    (var Msg:tMessage);
                              virtual id_first + id_AddPlayer;
  end;

  pNFLWindow = ^tNFLWindow;
  tNFLWindow = object(tWindow)
    nflicon       : hicon;
    LogoBitmap    : pTBMP;
    constructor init(AParent:pWindowsObject; ATitle:pChar);
    destructor  done; virtual;
    procedure GetWindowClass(var WndClass : tWndClass); virtual;
    procedure Paint(PaintDC : HDC; var PaintInfo : TPaintStruct); virtual;
    procedure Schedule     (var Msg: TMessage);
                            virtual cm_First + cm_EnterSchedule;
    procedure PlayerMaint  (var Msg: TMessage);
                            virtual cm_First + cm_PlayerMaint;
    procedure DeleteSched  (var msg:tmessage);
                            virtual cm_first + cm_DeleteSchedule;
    procedure DeletePlayers(var msg:tmessage);
                            virtual cm_first + cm_DeletePlayers;
    procedure Scores       (var Msg: TMessage);
                            virtual cm_First + cm_EnterScores;
    procedure PrintSchedule(var Msg: TMessage);
                            virtual cm_First + cm_PrintSchedule;
    procedure PrintResults (var Msg: TMessage);
                            virtual cm_First + cm_PrintResults;
    procedure SetUpPrinter (var Msg: TMessage);
                            virtual cm_First + cm_SetUpPrinter;
    procedure EnterPicks   (var msg: tMessage);
                            virtual cm_First + cm_EnterPicks;
    procedure AboutBox     (var msg: tMessage);
                            virtual cm_First + cm_About;

  end;

  pPrintItOut = ^tPrintItOut;
  tPrintItOut = object(tPrintout)
    maxX    :  word;        {max width of page}
    maxY    :  word;         {max height of page}
    posX    :  word;        {current column}
    posY    :  word;        {current row}
        Height  :  word;
        Width   :  word;
    metrics : TTextMetric;    {text metric information}
        myfont  : tlogfont;
        thefont : hfont;
        ps      : tpoint;
        PixX,PixY,Center,
        PageVert,PageHorz : integer;
  procedure selectfont(dc:hdc; LinesPerPage,CharsPerLine:word);
  procedure PrintPage(DC:HDC; page:word; Size:tPoint;
                      var Rect:tRect; Flags:word); virtual;
  end;

  pPrintResultsOut = ^tPrintResultsOut;
  tPrintResultsOut = object(tPrintItOut)
        procedure PrintPage(DC:HDC; page:word; Size:tPoint;
                            var Rect:tRect; Flags:word); virtual;
  end;

  MyLong = record
    case integer of
       0 : (TheLong: Longint);
       1 : (lo :word;
            Hi : word);
  end;

var
   week          : integer;
   aLong         : myLong;
   SchedBuffer   : SchdTransferRec;
   SchedColl     : pStrCollection;
   ScheduleStream: tBufStream;
   PlayerStream  : tBufStream;
   PlayerList    : pCollection;
   PlayerRec     : Player;
   PlayerCollection : ListRec;
   SchedRec      : pSchedule;
   vSchedule     : Schedule;
   vPickRec      : tPickRec;
   vResults      : tResults;
   defaultprinter: pPrinter;

const
  WeekStr : array [1..MaxWeeks] of array[0..255] of char =
  (' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10','11','12','13','14','15','16','17','18');
  rSchedule : tstreamrec = (
              objtype : 151;
              vmtlink: ofs(typeof(tSchedule)^);
              load : @tSchedule.load;
              store: @tSchedule.store);

constructor tSchedule.init(NewSchedule:Schedule);
begin
     tobject.init;
     ScheduleRec := NewSchedule;
end;

constructor tSchedule.load(var s:tBufStream);
begin
     s.read(ScheduleRec,sizeof(ScheduleRec));
end;

procedure tSchedule.Store(var s:tBufStream);
begin
     s.write(ScheduleRec,sizeof(ScheduleRec));
end;

destructor tSchedule.done;
begin
     tobject.Done;
end;

procedure tMyDialog.wmCtlColor(var msg:tmessage);
begin
     case msg.lparamhi of
     ctlColor_static:
        begin
             msg.result:= GetStockObject(Null_Brush);
             SetBkMode(msg.wparam,Transparent);
        end;
      ctlColor_Btn :
        begin
             msg.result:= GetStockObject(ltgray_Brush);
             SetBkMode(msg.wparam,Transparent);
        end;
      else defwndproc(msg);
      end; {case}

end;

procedure tScoreDialog.wmCtlColor(var msg:tmessage);
begin
     case msg.lparamhi of
     CtlColor_static:
        begin
             case GetDlgCtrlID(msg.lParamLo) of
               id_Transparent : msg.result:= GetStockObject(Null_Brush);
             else msg.result:= GetStockObject(ltGray_Brush);
             end; {case}
             SetBkMode(msg.wparam,transparent);
        end;
      else tMyDialog.wmCtlColor(msg);
      end;
end;

procedure tNumericEdit.wmChar(var Msg : tMessage);
begin
     if (msg.message = wm_char)
     and not (msg.wParam in [8,48..57])
     then messagebeep(0)
     else defwndproc(msg);
end;

constructor tNFLApp.Init(AName: PChar);

var x,w,g : integer;
begin
     Week := 1;
     Lib := LoadLibrary(DLLName);
     if Lib < 32 then Status := em_DLLNotFound;
     TApplication.Init(AName);
     registertype(rSchedule);
     registertype(rPlayer);
     registerwobjects;
     ScheduleStream.init('NflSch.stm',stOpen,512);
     schedrec := new(pSchedule, init(vSchedule));
     PlayerStream.init('NFLPlayr.stm',stOpen,512);
     playerlist := pcollection(PlayerStream.get);
     PlayerStream.done;
end;

procedure tNFLApp.WritePlayerList;
var x:integer;
begin
     PlayerStream.init('NFLPlayr.stm',stopen,512);
     PlayerStream.put(playerlist);
     PlayerStream.done;
end;

destructor tNFLApp.Done;
begin
     ScheduleStream.done;
     WritePlayerList;
     if playerlist <> nil
     then Dispose(playerlist,done);
     if DefaultPrinter <> nil
     then dispose(DefaultPrinter,done);
     TApplication.Done;
     FreeLibrary(Lib);
end;

procedure tNFLWindow.DeleteSched(var Msg: TMessage);
var
  c,g,t,SchedKey : word;

begin
     c:=MessageBox(hWindow,'Do you really want to delete the schedule?',
                 'Delete Schedule', mb_OKCancel or mb_iconstop);
     if c = id_OK then
     begin
          ScheduleStream.done;
          ScheduleStream.init('nflsch.stm',stCreate,512);
          for SchedKey:=1 to MaxWeeks do
          begin
               for g := 1 to MaxGames do
               for t := 0 to 1 do
               with SchedRec^.ScheduleRec do
               begin
                    Team[g,t] := 0;
                    GameScore.Score[g,t] := 0;
               end;
               ScheduleStream.put(Schedrec);
          end;
          ScheduleStream.done;
          ScheduleStream.init('NflSch.stm',stOpen,512);
     end;
end;

procedure tNFLWindow.Schedule(var Msg: TMessage);
begin
    Application^.ExecDialog(new(pSchDialog,init(@self,'Schedule')));
end;

procedure tNFLWindow.Scores(var Msg: TMessage);
begin
    Application^.ExecDialog(new(pScoreDialog,init(@self,'Scores')));
end;

procedure tNFLWindow.PrintSchedule(var Msg: TMessage);
var Printout : pPrintItOut;
begin
     if (Application^.ExecDialog(new
        (pPrintSchedDlg,init(@self,'PrintSchedule'))) = id_ok) then
     begin
          ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
          SchedRec := pSchedule(ScheduleStream.get);
          if DefaultPrinter = nil
          then DefaultPrinter := New(PPrinter, Init);
          printout := new(pPrintItOut,init('NFL Schedule'));
          defaultprinter^.Print(@self,printout);
          dispose(printout,done);
     end;
end;

procedure tNFLWindow.PrintResults(var Msg: TMessage);
var Printout : pPrintResultsOut;
begin
     if (Application^.ExecDialog(
         new(pPrintSchedDlg,init(@self,'PrintResults'))) = id_ok) then
     begin
          ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
          SchedRec := pSchedule(ScheduleStream.get);
          if DefaultPrinter = nil
          then DefaultPrinter := New(PPrinter, Init);
          printout := new(pPrintResultsOut,init('NFL Results'));
          defaultprinter^.Print(@self,printout);
          dispose(printout,done);
     end;
end;

procedure tNFLWindow.SetUpPrinter(var Msg: TMessage);
begin
     if DefaultPrinter = nil
     then DefaultPrinter := New(PPrinter, Init);
     DefaultPrinter^.Setup(@self);
end;

constructor tSchDialog.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
     tDialog.init(aParent,aName);
     new(sWeek, initResource(@self,id_Week));
     for x := 1 to MaxTeams
     do
     begin
          new(combo[x], InitResource(@self,id_BoxMask+x,
            sizeof(SchedBuffer.StrTeams[x].ComboSelection)));
     end;
     TransferBuffer := @SchedBuffer;
end;

procedure tSchDialog.SetUpWindow;
var TextItem : array [0..255] of char;
    x,y,g,t : word;
begin
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     SchedRec := pSchedule(ScheduleStream.get);
     tdialog.Setupwindow;
     TransferData(tf_SetData);
     x:= 1;
     for g := 1 to MaxGames do
     for t := 0 to 1 do
     with SchedRec^.ScheduleRec do
     begin
          y := team[g,t];
          combo[x]^.setselindex(Team[g,t]);
          inc(x);
     end;
end;

procedure tSchDialog.StoreSched;
var g,t,x,y : word;
begin
     x := 1;
     for g := 1 to MaxGames do
     for t := 0 to 1 do
     with SchedRec^.ScheduleRec do
     begin
          y := team[g,t];
          team[g,t] := combo[x]^.GetSelIndex;
          inc(x);
     end;
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     ScheduleStream.put(Schedrec);
end;

procedure tSchDialog.HandleListBox(var Msg: TMessage);
var x,y,g,t : word;
begin
     if Msg.lParamHi = lbn_SelChange then
     begin
          StoreSched;
          Week := sWeek^.GetSelIndex+1;
          ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
          SchedRec := pSchedule(ScheduleStream.get);
          x:= 1;
          for g := 1 to MaxGames do
          for t := 0 to 1 do
          with SchedRec^.ScheduleRec do
          begin
               y := team[g,t];
               combo[x]^.setselindex(Team[g,t]);
               inc(x);
          end;
          TransferData(tf_GetData);
     end
     else DefWndProc(msg);
end;

procedure tSchDialog.OK(var Msg: TMessage);
var g,t,x,y : word;
begin
     x := 1;
     for g := 1 to MaxGames do
     for t := 0 to 1 do
     with SchedRec^.ScheduleRec do
     begin
          y := team[g,t];
          team[g,t] := combo[x]^.GetSelIndex;
          inc(x);
     end;
     tDialog.ok(Msg);
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     ScheduleStream.put(Schedrec);
end;

constructor tPrintSchedDlg.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
     tDialog.init(aParent,aName);
     new(PrintWeek, initResource(@self,id_Week));
end;

procedure tPrintSchedDlg.SetUpWindow;
var x : integer;
begin
     tdialog.Setupwindow;
     for x := 1 to MaxWeeks
     do PrintWeek^.AddString(WeekStr[x]);
     PrintWeek^.SetSelIndex(Week-1);
end;

procedure tPrintSchedDlg.HandleListBox(var Msg: TMessage);
begin
     if Msg.lParamHi = lbn_SelChange then
     begin
          Week := PrintWeek^.GetSelIndex+1;
          SchedBuffer.strWeek.ListSelection := week - 1;
     end
     else DefWndProc(msg);
end;

constructor tScoreDialog.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
     tDialog.init(aParent,aName);
     new(scoreWeek, initResource(@self,id_Week));
     for x := 1 to MaxTeams
     do
     begin
          new(TeamName[x], InitResource(@self,id_TeamMask+x,TeamNameSize));
          new(ScoreEdit[x], InitResource(@self,id_BoxMask+x,ScoreFieldSize));
     end;
end;

procedure tScoreDialog.BuildSchedule;
var x,y,g,t : word;
    msg : tmessage;
    OutStr : array[0..4] of char;
    s : string;
begin
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     SchedRec := pSchedule(ScheduleStream.get);
     x:= 1;
     for g := 1 to MaxGames do
     for t := 0 to 1 do
     with SchedRec^.ScheduleRec do
     begin
          str(gamescore.score[g,t]:3,s);
          if (team[g,t] = 0) and
             (gamescore.score[g,t] = 0)
          then OutStr[0] := #00
          else strpcopy(outstr,s);
          SetDlgItemText(hWindow,id_BoxMask  + x,strnew(outstr));
          SetDlgItemText(hWindow,id_TeamMask + x,
                         pChar(SchedColl^.at(team[g,t])));
          if OutStr[0] = #00
          then ScoreEdit[x]^.Show(sw_Hide)
          else ScoreEdit[x]^.Show(sw_Show);
          inc(x);
     end;
end;

procedure tScoreDialog.StoreScores;
var x,g,t    : word;
    ScoreStr : array [0..4] of char;
    result : integer;
begin
     x:= 1;
     for g := 1 to MaxGames do
     for t := 0 to 1 do
     with SchedRec^.ScheduleRec do
     begin
          ScoreEdit[x]^.GetSubText(ScoreStr,0,3);
          val(strpas(scorestr),GameScore.Score[g,t],result);
          inc(x);
     end;
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     ScheduleStream.put(Schedrec);
end;

procedure tScoreDialog.SetUpWindow;
var x : word;
begin
     tdialog.Setupwindow;
     for x := 1 to MaxWeeks
     do ScoreWeek^.AddString(WeekStr[x]);
     ScoreWeek^.SetSelIndex(Week-1);
     BuildSchedule;
end;

procedure tScoreDialog.HandleListBox(var Msg: TMessage);
begin
     if Msg.lParamHi = lbn_SelChange then
     begin
          StoreScores;
          Week := ScoreWeek^.GetSelIndex+1;
          BuildSchedule;
          SchedBuffer.strWeek.ListSelection := week - 1;
     end
     else DefWndProc(msg);
end;

procedure tScoreDialog.OK(var Msg: TMessage);
var g,t,x,y,result : word;
begin
     StoreScores;
     tDialog.ok(Msg);
end;

constructor tNFLWindow.Init(AParent:pWindowsObject; ATitle:pChar);
var x,y : word;
    textitem : array [0..255] of Char;
    result : integer;
begin
     SchedColl := new(pStrCollection, init(29,0));
     SchedBuffer.strWeek.ListStrings := new(pStrCollection, init(MaxWeeks,0));
     for x:= 1 to MaxWeeks do
     begin
         SchedBuffer.strWeek.ListStrings^.insert(@WeekStr[x]);
     end;
     for x:= 0 to MaxTeams do
     begin
          LoadString(hInstance, x, @textitem,
                     sizeof(SchedBuffer.strTeams[x].ComboSelection));
          SchedColl^.insert(StrNew(@TextItem));
     end;
     for y := 1 to MaxTeams do
     begin
          SchedBuffer.strteams[y].ComboStrings := schedcoll;
     end;
     SchedBuffer.strWeek.ListSelection := week - 1;
     tWindow.Init(AParent,ATitle);
     Attr.Menu := LoadMenu(HInstance, 'MainMenu');
     LogoBitmap := new(pTBMP, init('NFL'));
     if not logobitmap^.LoadBitmapFile('NFL.BMP')
     then MessageBox(hwindow,'Could Not Load Logo','ERROR',mb_ok);
end;

procedure tNFLWindow.Paint(PaintDC : HDC; var PaintInfo : TPaintStruct);
var
PictRect : trect;
scale : boolean;
begin
     scale := true;
     getclientrect(hwindow,pictrect);
     LogoBitmap^.Draw(PaintDC,PictRect,Scale);
end;

procedure TNFLWindow.GetWindowClass;
begin
    TWindow.GetWindowClass(WndClass);
    NflIcon := LoadIcon(HInstance,'NFL');
    WndClass.hIcon := NFLIcon;
end;

procedure tNFLwindow.AboutBox(var msg: tMessage);
var dlg : pmydialog;
begin
     dlg := new(pMydialog,init(@self,'About'));
     Application^.execdialog(dlg);
end;

procedure tNFLwindow.EnterPicks(var msg: tMessage);
begin
     Application^.execdialog(new(pPicksdialog,init(@self,'Picks')));
end;

constructor tPicksDialog.init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
     tdialog.init(aParent,aName);
     new(PickWeek, InitResource(@self, Id_week));
     new(PickPlayer, initResource(@self,id_PlayerCombo,PlayerNameSize));
     for x := 1 to maxgames*3
     do new(ButtonName[x], InitResource(@self,id_ButtonMask+x));
     new(PickPoints, InitResource(@self,id_PickPoints,4));
end;

procedure tPicksDialog.BuildButtons;
var x,y,z       : word;
    s           : string;
    p           : Array [0..3] of Char;
    Hidden      : boolean;
    PlayerName  : array[0..PlayerNameSize] of char;
 function FindPlayer(P:pPlayer) : boolean; far;
 begin
      FindPlayer := StrComp(P^.Name,PlayerName) = 0;
 end;

 function CheckState(P:PickType) : word;
 begin
      if ((FoundPlayer^.PickRec[Week].GamePick[x]) = ord(p))
      then CheckState := 1
      else CheckState := 0;
 end;
begin
     ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
     SchedRec := pSchedule(ScheduleStream.get);
     PickPlayer^.GetSelString(PlayerName,PlayerNameSize);
     FoundPlayer := PlayerList^.FirstThat(@FindPlayer);
     if FoundPlayer = nil
     then exit;
     z := 1;
     for x:= 1 to MaxGames do
     begin
          for y:= 0 to 2 do
          begin
               case y of
               0,1 :
               begin
                    SetDlgItemText(hWindow,id_ButtonMask+z,
                    pChar(SchedColl^.at(SchedRec^.Schedulerec.team[x,y])));
                    if StrLen(pChar(SchedColl^.at(SchedRec^.Schedulerec.team[x,y]))) < 2
                    then Hidden := true
                    else Hidden := false;
               end;
               2   : SetDlgItemText(hWindow,id_ButtonMask+z,'None');
               end; {case}
               if Hidden
               then ButtonName[z]^.Show(sw_Hide)
               else ButtonName[z]^.Show(sw_show);
               Inc(z);
          end;
          ButtonName[x*3-2]^.SetCheck(CheckState(Visitor));
          ButtonName[x*3-1]^.SetCheck(CheckState(Home));
          ButtonName[x*3  ]^.SetCheck(CheckState(None));
     end;
     str(FoundPlayer^.PickRec[Week].MNFScore,s);
     strpcopy(p,s);
     SetDlgItemText(hWindow,id_PickPoints,p);
end;

procedure tPicksDialog.StorePicks;
var x,
    result,
    Score   : word;
    p       : array[0..3] of Char;
    StartPos, EndPos: integer;
begin
     for x:= 1 to MaxGames do
          if ButtonName[x*3-2]^.GetCheck = bf_Checked
          then FoundPlayer^.PickRec[Week].GamePick[x] := 0
          else if ButtonName[x*3-1]^.GetCheck = bf_Checked
          then FoundPlayer^.PickRec[Week].GamePick[x] := 1
          else if ButtonName[x*3  ]^.GetCheck = bf_Checked
          then FoundPlayer^.PickRec[Week].GamePick[x] := 2;
     PickPoints^.GetSubText(p,0,3);
     val(strpas(p),Score,Result);
     FoundPlayer^.PickRec[Week].MNFScore := score;
end;

procedure tPicksDialog.SetUpWindow;

 procedure BuildList(P:pPlayer); far;
 begin
      PickPlayer^.addString(StrNew(P^.Name));
 end;

var x:word;
    msg:tmessage;
begin
     tdialog.Setupwindow;
     for x := 1 to MaxWeeks
     do PickWeek^.AddString(WeekStr[x]);
     PickWeek^.SetSelIndex(Week-1);
     PlayerList^.ForEach(@BuildList);
     PickPlayer^.SetSelIndex(0);
     BuildButtons;
     if FoundPlayer = nil then
     begin
          messagebeep(0);
          messagebox(hwindow,'You must first add a player to pick results',
                    'Error',mb_ok or mb_iconstop);
          tdialog.cancel(msg);
     end;
end;

procedure tPicksDialog.HandleListBox(var Msg: TMessage);
begin
     if   (Msg.lParamHi = lbn_SelChange)
     and  (Week <> PickWeek^.GetSelIndex+1) then
     begin
          StorePicks;
          Week := PickWeek^.GetSelIndex+1;
          BuildButtons;
     end
     else DefWndProc(msg);
end;

procedure tPicksDialog.HandleComboBox(var Msg: TMessage);
begin
     if Msg.lParamHi = lbn_SelChange then
     begin
          StorePicks;
          BuildButtons;
     end;
end;

procedure tPicksDialog.Cancel(var Msg: TMessage);
begin
     StorePicks;
     tDialog.Cancel(msg);
end;

procedure tPicksDialog.OK(var Msg: TMessage);
begin
     StorePicks;
     tDialog.OK(msg);
end;

destructor tPicksDialog.done;
begin
     tDialog.Done;
end;

constructor tPlayerMaintDlg.init(aParent:pWindowsObject; aName:pChar);
begin
     tdialog.init(aParent,aName);
     new(PlayerListBox, initResource(@self,id_PlayerBox));
end;

procedure tPlayerMaintDlg.SetUpWindow;
 procedure BuildList(P:pPlayer); far;
 begin
      PlayerListBox^.AddString(p^.Name);
 end;

begin
     tdialog.Setupwindow;
     PlayerList^.ForEach(@BuildList);
     PlayerListBox^.SetSelIndex(0);
end;

destructor tPlayerMaintDlg.Done;
begin
     dispose(PlayerListBox, done);
     tdialog.Done;
end;

procedure tNFLwindow.PlayerMaint(var msg: tMessage);
var dlg : pplayermaintdlg;
begin
     Application^.execdialog(new(pPlayerMaintDlg,init(@self,'PlayerMaintenance')));
end;

procedure tPlayerMaintDlg.AddPlayer(var Msg: TMessage);
var EditText : array[0..PlayerNameSize] of char;
    w,g    : word;
    result : integer;
var
    rcUpdate : TRect;
begin
     EditText[0] := #00;
     if (Application^.ExecDialog(new(pInputDialog, Init(@self, 'Add Player',
       'Enter New Player''s Name:',EditText,SizeOf(EditText)))) = id_ok )
     and (strlen(edittext) > 0)  then
     with PlayerRec do
     begin
          result := playerlistbox^.SetSelString(EditText,-1);
          if (result > -1)
          and(PlayerListBox^.GetStringLen(result) = StrLen(EditText)) then
          begin
               MessageBeep(0);
               MessageBox(hWindow,'Player already exists.','Error',
                          mb_ok or mb_IconExclamation);
          end
          else
          begin
               Name := strnew(@EditText);
               fillchar(vresults,sizeof(vResults),#00);
               fillchar(vPickRec,sizeof(vPickRec),#00);
               for w := 1 to MaxWeeks do
               for g := 1 to MaxGames do
               vPickRec[w].GamePick[g] := 2;
               PlayerList^.Insert(new(pPlayer,init(Name,vPickrec,vResults)));
               PlayerListBox^.AddString(Name);
               getUpdateRect(Hwindow,rcUpdate,False);
               PlayerListBox^.SetSelString(Name,-1);
               RedrawWindow(Hwindow,@rcUpdate,0, RDW_INVALIDATE or
                            RDW_UPDATENOW or RDW_ALLCHILDREN);
          end;
     end;
end;

procedure tPlayerMaintDlg.DeletePlayer(var Msg: TMessage);
var MsgText   : array [0..128] of char;
    MsgName   : array [0..50]  of char;
    ListIndex,
    ListCount : integer;
 function FindPlayerToDelete(P:pPlayer): boolean; far;
 begin
      FindPlayerToDelete := strcomp(p^.Name,msgname) = 0;
 end;
begin
     ListIndex:= PlayerListBox^.GetSelIndex;
     if ListIndex < 0
     then
     begin
          messagebeep(0);
          MessageBox(hWindow,
                     'No Player Selected To Delete!',
                     'Error',
                     mb_ok or mb_IconExclamation);
     end
     else
     begin
          PlayerListBox^.GetSelString(MsgName,50);
          Strcopy(MsgText,'Delete ');
          StrCat (MsgText,MsgName);
          StrCat (MsgText,'?');
          if MessageBox(hWindow,
                        MsgText,
                        'Delete Player',
                        mb_OKCancel or mb_iconstop) = id_ok then
          begin
               ListCount := PlayerListBox^.DeleteString(ListIndex);
               PlayerList^.Delete(PlayerList^.FirstThat(@FindPlayerToDelete));
               If ListCount = listindex
               then PlayerListBox^.SetSelIndex(Listindex-1)
               else PlayerListBox^.SetSelIndex(ListIndex);

          end;
     end;
end;

procedure tNFLwindow.DeletePlayers(var msg: tMessage);
begin
     if MessageBox(hWindow,'Do you really want to delete the Player Roster?',
        'Purge Players', mb_OKCancel or mb_iconstop)
     = id_ok then
     begin
          if playerlist <> nil
          then PlayerList^.freeAll;
          NFLapp.WritePlayerList;
     end;
end;

procedure tPrintItOut.SelectFont(dc:hdc;LinesPerPage,CharsPerLine:word);
begin
     gettextmetrics(dc,metrics);
     pixX     := getdevicecaps(dc,LogPixelsX);
     pixY     := getdevicecaps(dc,LogPixelsY);
     pageVert := getdevicecaps(dc,VertRes);
     pageHorz := getdevicecaps(dc,HorzRes);
     with myfont do
     begin
          lfheight         := PageVert div LinesPerPage;
          lfwidth          := PageHorz div CharsPerLine;
          lfescapement     := 0;
          lforientation    := 0;
          lfweight         := fw_dontcare;
          lfitalic         := 0;
          lfunderline      := 0;
          lfstrikeout      := 0;
          lfcharset        := ansi_charset;
          lfoutprecision   := out_default_precis;
          lfclipprecision  := clip_default_precis;
          lfquality        := default_quality;
          lfpitchandfamily := variable_pitch or ff_swiss;
          strcopy             (@lffacename,'Arial');
     end;
     Center := PageHorz div 2;
     thefont := createfontindirect(myfont);
     selectobject(dc,thefont);
     gettextmetrics(dc,metrics);
     Height := metrics.tmHeight + metrics.tmExternalLeading;
     Width  := metrics.tmAveCharWidth;
     ps.X := GetDeviceCaps(DC,HorzRes);
     ps.Y := GetDeviceCaps(DC,VertRes);
     maxX := ps.x-1;
     maxY := ps.y-1;
     posx:= 0;
     posY:= 0;
end;

procedure tPrintItOut.PrintPage(DC:HDC; page:word; Size:tPoint;
                                 var Rect:tRect; Flags:word);

const Heading1   : pChar = ('N.F.L. Schedule');
      MNF        : pChar = ('Monday Night Football');
      Footing    : pChar = ('Total MNF Points');
var
   x,g,t : word;
   p : pchar;
   ThePen,OldPen : hPen;
   outstr:array[0..80] of char;
begin
     SelectFont(dc,25,32);
     textout(dc,PageHorz div 5,posY,Heading1,strlen(Heading1));
     inc(posY,Height);
     wvsprintf(OutStr,'Week %d',week);
     textout(dc,(PageHorz div 3),posY,OutStr,strlen(OutStr));
     inc(posY,Height);
     for g := 1 to MaxGames do
     with SchedRec^.ScheduleRec do
     begin
          if g = 14 then
          begin
               inc(posY,(Height div 2));
               textout(dc,(pagehorz div 8),posY,MNF,strlen(MNF));
               inc(posY,Height);
          end;
          p:= pChar(SchedColl^.at(team[g,0]));
          textout(dc,posX,posY,p,strlen(p));
          p:=pChar(SchedColl^.at(team[g,1]));
          textout(dc,Center,posY,p,strlen(p));
          inc(posY,Height);
          inc(x);
     end;
     inc(posY,Height div 2);
     textout(dc,PageHorz div 6,posY,Footing,strlen(Footing));
     inc(posY,Height);
     ThePen := createpen(ps_solid,10,0);
     OldPen := SelectObject(dc,ThePen);
     Rectangle(dc,Width * 12,posY,Width * 16,posY + Height*2);
     SelectObject(dc,OldPen);
     deleteobject(thepen);
     deleteobject(thefont);
end;
procedure tPrintResultsOut.PrintPage(DC:HDC; page:word; Size:tPoint;
                                     var Rect:tRect; Flags:word);
var WeeklyStandings : pStandingsCollection;
    YTDStandings    : pStandingsCollection;
    pStr : array [0..80] of char;
    s,WeekStr : String;
    OutStr : array [0..80] of char;
    TabStops :integer;
    pLine : pchar;

procedure NewPage;
begin
     escape(dc,NewFrame,0,nil,nil);
     posX := 0;
     posY := 0;
     selectobject(dc,thefont);
end;

procedure CheckEOP;
begin
     if posy > maxy
     then NewPage;
end;

procedure PrintIt(p:pStandings); far;
var s : string;
    pStr : array[0..5] of char;
    OutRec : record
           outwins,
           outlosses,
           outties,
           outpts : word;
     end;
begin
     if (p^.Wins<>0) or (p^.Losses<>0) or (p^.Ties<>0) then
     begin
         textout(dc,posX,posY,p^.Name,strlen(p^.Name));
         OutRec.OutWins   := p^.wins;
         OutRec.OutLosses := p^.losses;
         OutRec.OutTies   := p^.Ties;
         OutRec.OutPts    := p^.PtDiff;
         wvsprintf(OutStr,'%4d'#09'%4d'#09'%4d'#09'%4d',OutRec);
         TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
                         ,0,TabStops,0);
         inc(posY,Height);
         CheckEOP;
     end;
end;

procedure CalculateResults(p:pPlayer); far;
var x,w,g,t,
    YTDWins,
    YTDLosses,
    YTDTies,
    YTDPtDiff : word;
begin
     with p^.PickRec[Week] do
     with SchedRec^.ScheduleRec.GameScore do
     begin
          p^.Results[Week].Wins   := 0;
          p^.Results[Week].Losses := 0;
          p^.Results[Week].Ties   := 0;
          YTDWins   :=0;
          YTDLosses :=0;
          YTDTies   :=0;
          YTDPtDiff :=0;
          for g := 1 to MaxGames do
          if ((Score[g,0]  <> 0)
           or (Score[g,1]  <> 0))
          and (GamePick[g] <> 2)
          then if Score[g,0] = Score[g,1]
               then inc(p^.Results[Week].Ties)
               else if Score[g,0] > Score[g,1]
               then if GamePick[g] = 0
                    then inc(p^.Results[Week].Wins)
                    else inc(p^.Results[Week].Losses)
               else if GamePick[g] = 1
                    then inc(p^.Results[Week].Wins)
                    else inc(p^.Results[Week].Losses);
          p^.Results[Week].PtDiff :=
             abs(MNFScore - Score[14,0] - Score[14,1]);
          WeeklyStandings^.insert(new(pStandings, init(p^.Name,
                                      p^.Results[Week].Wins,
                                      p^.Results[Week].Losses,
                                      p^.Results[Week].Ties,
                                      p^.Results[Week].PtDiff)));
          for w := 1 to Week do
          begin
               inc(YTDWins  ,p^.Results[w].Wins);
               inc(YTDLosses,p^.Results[w].Losses);
               inc(YTDTies  ,p^.Results[w].Ties);
               inc(YTDPtDiff,p^.Results[w].PtDiff);
          end;
          YTDStandings^.insert(new
          (pStandings, init(p^.Name,YTDWins,YTDLosses,YTDTies,YTDPtDiff)));
     end;
end;

var heading : record
            col1 : pChar;
            col2 : pChar;
            Col3 : pChar;
            Col4 : pChar;
    end;
begin
     SelectFont(dc,60,80);
     wvsprintf(OutStr,'Standings For Week %d',week);
     textout(dc,posX,posY,OutStr,strlen(OutStr));
     inc(posY,Height*2);
     textout(dc,posX             ,posY,'Player',strlen('Player'));
     heading.col1:= 'Wins';
     heading.Col2:= 'Loss';
     heading.col3:= 'Ties';
     heading.col4:= 'Points';
     wvsprintf(OutStr,'%-4s'#09'%-4s'#09'%-4s'#09'%-6s',
               heading);
     TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
                     ,0,TabStops,0);
     inc(posY,Height);
     WeeklyStandings := new(pStandingsCollection, init(20,10));
     YTDStandings    := new(pStandingsCollection, init(20,10));
     PlayerList^.ForEach(@CalculateResults);
     weeklystandings^.ForEach(@PrintIt);
     dispose(weeklystandings,done);
     NewPage;
     wvsprintf(OutStr,'YTD Standings Thru Week %d',week);
     textout(dc,posX,posY,OutStr,strlen(OutStr));
     inc(posY,Height*2);
     textout(dc,posX             ,posY,'Player',strlen('Player'));
     wvsprintf(OutStr,'%-4s'#09'%-4s'#09'%-4s'#09'%-6s',
               heading);
     TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
                     ,0,TabStops,0);
     inc(posY,Height);
     YTDStandings^.ForEach(@PrintIt);
     dispose(YTDStandings,done);
     deleteobject(TheFont);
end;
destructor tNFLWindow.Done;
begin
     dispose(LogoBitmap,done);
     deleteobject( NFLIcon);
     twindow.done;
end;
procedure tNFLApp.InitMainWindow;
begin
     MainWindow := new(pNFLWindow, init(nil,'NFL Office Pool'));
end;

begin
     CmdShow := sw_ShowMaximized;
     NFLApp.init('NFL Program');
     NFLApp.run;
     NFLApp.done;
end.